stazsoftware.com/www.stazsoftware.com.tar/www.stazsoftware.com/futurebasic/sample-code/helpProj.sit/Help Project Folder/List Display.INCL

Text File | 2005-04-15 | 13KB | 400 lines

'~'1
/*
     "List.INCL" file for Program Generator files
      can be modified for not PG projects
     Adapted for use with FB^3 by David Bailey - dabsoftware.com
     12/29/2002
     Free source code
*/
'~'1


GOTO "EndOfList"

BEGIN GLOBALS

BEGIN Record ListRecord
DIM as int       ncols'number of colums
dim as long      numRecords'number of records filled in after first drawing
dim as int       STResNo'Using a String Resource in this example
DIM as int       LScrollBtn
DIM as LONG      LScrlBtnMax
dim as rect      ListRect'The overall rectangle for the list
DIM as rect      selrect[20]
DIM as int       colwd%[20]'20 columns each can have their own width
Dim as RGBCOLOR  RGB[20]'each column can have a different color
DIM as INT       txtalign[20]'left = 0, right = 1, center = 2
DIM as int       oldselect'the list row previously selected
dim as int       newselect'the new selection if there is one
dim as int       WhichString'which string in the resouce selected
DIM as INT       buttonsized
dim as int       fnt'the font to use
dim as int       sze'the size to use
dim as int       styl'the style to use
DIM as str255    2 delim$'the delimiting character for each row
DIM as str255    2 icon$'the delim string noting what follows is an icon id and not a string
end record


'~'4
'You must dimension one global list record for each list you want to draw
'~'4
DIM HelpList         as ListRecord

end globals

'~':

/*
     This function draws the list using a handle to various data
*/
CLEAR LOCAL
dim as rgbcolor   rg
dim as rect       tBox
dim as STR255     t$,delim$,t2$
dim as long       count
dim as RECT       col(20)
dim as int        c,x,y,pt,pt2,numRows,xp,iconwd,err,n
dim as FontInfo   myFontInfo
dim as rgbcolor   hilite
'~'2
local fn DrawList(List AS ^ListRecord)'WhichList)
'~'2
rg.red = 60000
rg.blue = 65000
rg.green = 62000
GetPortHiliteColor (WINDOW(_wndPort),hilite)'to set hilite color
text List.fnt,List.sze,List.styl,_SrcOr'set the font from the record
GetFontInfo(myFontInfo)'get the font infor for placing string with descent

col.top(1)    = List.ListRect.top+1'Top of first cell
col.left(1)   = List.ListRect.left+1'Left side of first cell
col.bottom(1) = col.top(1) + USR FONTHEIGHT+1'bottom of first cell
col.right(1)  = col.left(1) + List.colwd[1]'right side of first cell
Long if col.right(1) > List.ListRect.right-1'if we made it too wide
col.right(1) = List.ListRect.right-1'set it to the widest possible
END IF
LONG IF List.ncols = 1'only one column
Long if col.right(1) < List.ListRect.right'we did not set the width correctly
col.right(1) = List.ListRect.right'so set it to the width of the list
END IF'some of this above can be removed if you never pass the incorrect width/num of columns etc
END IF
iconwd = col.bottom(1) - col.top(1)'make any icon cell square

LONG IF List.ncols > 1'Loop through the
FOR c = 2 to List.ncols'remaining columns
col(c);8     = @col(1)'and set the left
col.left(c)  = col.right(c-1)-1'and right sides
col.right(c) = col.left(c) + List.colwd[c]'for this column
Long if col.right(c) > List.ListRect.right-1'if what we add up is too wide for the list
col.right(c) = List.ListRect.right-1'set it to the max width
END IF
IF c = List.ncols then col.right(c) = List.ListRect.right-1'if it is the last column set to the edge
NEXT
end if

for c = 2 to List.ncols'width modify selection rectangles
setrect(List.selrect[c],col.left(c)-2,col.top(c),col.left(c)+3,col.top(c)+USR FONTHEIGHT+1)
NEXT

CLIPRECT(List.ListRect)'only draw within the list
count = button(List.LScrollBtn)'check the current position of the scroll bar
IF count <= 0 then count = 1'if it is the first drawing we many not have a value yet

flushwindowbuffer _FBAutoFlushOff

PEN 1,1,1,0,3'for a dotted cell border
numRows = ((List.ListRect.bottom-List.ListRect.top)\(USR FONTHEIGHT))'calculate the number of visible rows
FOR y = count TO count + numRows'start with first visible cell and loop
LONG IF y <= List.numRecords
t$ = STR#(List.STResNo,y)'temp string with delim
XELSE
t$ = ""'beyond the end of the list so null the string
END IF
FOR x = 1 to List.ncols'create strings from this for each column
PENNORMAL'reset the pen
'forecolor(_blackcolor)'set to black to prepare for drawing grid

long if y mod 2 = 0'new itunes type color list separation
rgbforecolor(rg)
Paintrect(col(x))
xelse
foreCOLOR(_whitecolor)'get ready to erase
PAINTRECT(col(x))'erase to white - could be any color you want
end if

PEN 1,1,1,0,3'for a dotted cell border
forecolor(_blackcolor)
IF x > 1 THEN plot col.left(x),col.top(x) to col.left(x),col.bottom(x)

'FRAMERECT(col(x))'frame the cell
INSETRECT(col(x),1,1)'inset the cell for the text box
CLIPRECT(List.ListRect)'only draw within the list
LONG IF t$ <> ""
long IF x = 1'If its our first pass start with char 0
pt = 0
xelse
pt = pt2'else move to where the first column string ended
end if
pt2 = instr(pt+1,t$,List.delim$)'find the next delim in the string
t2$ =  MID$(t$,pt+1,pt2-pt-1)'parse the cell text between delim

IF pt2 = 0 then t$ = ""'if we reached the end the the cell is blank

LONG IF List.newselect = y'found our highlighted item
rgbbackcolor(hilite)
rgbforecolor(hilite)
Paintrect(col(x))
rgbforecolor(List.RGB[x])'our individual cell colors!!
xelse
rgbforecolor(List.RGB[x])'our individual cell colors!!
END IF

'backcolor(_whitecolor)
LONG IF LEFT$(t2$,1) = List.icon$'is this an icon id number?
t2$ = RIGHT$(t2$,LEN(t2$)-1)'get the id number of the icon family
n = col.right(x)
col.right(x) = col.left(x) + iconwd
'err = FN PlotIconID(@col(x), 0, 0, VAL(t2$))'depending on the size of rect ie ics4,icm4 etc
col.right(x) = n
xelse
rgbforecolor(List.RGB[x])'our individual cell colors!!
SELECT List.txtalign[x]
CASE 0'left alignment
moveto(col.left(x)+2,col.bottom(x)-myFontInfo.descent)
drawstring(t2$)
CASE 1'center alignment
xp = col.left(x) + ((col.right(x)-col.left(x))/2) - FN STRINGWIDTH(t2$)/2
moveto(xp,col.bottom(x)-myFontInfo.descent)
drawstring(t2$)
CASE 2'right alignment
xp = col.right(x) - FN STRINGWIDTH(t2$)
moveto(xp,col.bottom(x)-myFontInfo.descent)
drawstring(t2$)
END SELECT
END IF
END IF
INSETRECT(col(x),-1,-1)'reset cell to orig size
offsetrect(col(x),0,USR FONTHEIGHT)'offset to next row
CLIPRECT(List.ListRect)'only draw within the list
NEXT
NEXT
forecolor(_blackcolor)'return color to normal
CLIPRECT(gBigT)'set clip to full
pennormal
FRAMERECT(List.ListRect)'frame the list
LONG IF BUTTON(List.LScrollBtn) = 1' and List.newselect = 0'for this demo say we did not match the scroll button to the list height
SETRECT(tbox,List.ListRect.right,List.ListRect.top,List.ListRect.right + 16,List.ListRect.bottom)
xp = List.numRecords-numRows+1
if xp <= 0 then xp = 1
SCROLL BUTTON List.LScrollBtn,,,xp,,@tbox'you could put this in PG and then just resize it
END IF
flushwindowbuffer _FBAutoFlushOn
end fn


CLEAR LOCAL
DIM as handle btnHndl&
dim as rect   tbox
dim as int    x,WhichString,err,oldsel,newsel,top,j,numRows,BtnMax,CurRes,drawList
DIM as point  mPt
DIM as EventRecord evnt
DIM as str255  Selected$
'~'2
LOCAL FN DoListSelecton$(List AS ^ListRecord)'pass which list we clicked
'~'2
text List.fnt,List.sze,List.styl,_srcOr'set to proper font
numRows = (List.ListRect.bottom-List.ListRect.top)\(USR FONTHEIGHT)'set the number of rows depending on the font size
WHILE FN BUTTON'set the first row to a temp selection rectangle
setrect(tbox,List.ListRect.left+1,List.ListRect.top+1,List.ListRect.right-1,List.ListRect.top+USR FONTHEIGHT)
x = 1'verticle row counter
drawList = _FALSE'set to false for each loop beginning
DO
getmouse(mPt)'get the mouse location
LONG IF FN PTINRECT(mPt,tbox)'is it in THIS row?
newsel = x'Set the new selection to this row
LONG IF oldsel <> newsel'check to see if it is not already selected
LONG IF List.LScrollBtn
List.newselect = x + BUTTON(List.LScrollBtn) - 1'Set the list record selected row variable
XELSE
List.newselect = x
END IF
drawList = _TRUE
oldsel = x'make this the OLD selection now
END IF
EXIT DO'Exit the loop cuz we found the selection
XELSE
OFFSETRECT(tbox,0,USR FONTHEIGHT)'not the selected cell - offset and try again
END IF
LONG IF List.LScrollBtn > 0
SELECT
CASE mPt.v% < List.ListRect.top'mouse clicked in list and dragged above
LONG IF BUTTON(List.LScrollBtn) > 1 or List.newselect > 1'only if the button has room to move up
LONG IF List.newselect < BUTTON(List.LScrollBtn) + 1
scroll BUTTON List.LScrollBtn,BUTTON(List.LScrollBtn)-1'step the button one place
end if
LONG iF List.newselect > 1'only if selection is not the top row
List.newselect = List.newselect -1
END IF'set selection up one place
drawList = _TRUE
EXIT DO'Exit the loop cuz we found the selection
END IF
CASE mPt.v% > List.ListRect.bottom'same as above except we drag down here
LONG IF List.newselect < List.numRecords
LONG IF List.newselect > BUTTON(List.LScrollBtn) + numRows-2'scroll selected line until it reaches the bottom
scroll BUTTON List.LScrollBtn,BUTTON(List.LScrollBtn)+1'then start moving the scroll bar
END IF
LONG IF List.newselect < List.numRecords'if not at the bottom increment the item to show
List.newselect = List.newselect +1
END IF
drawList = _TRUE
EXIT DO'Exit the loop so we can draw
END IF
END SELECT
END IF
inc(x)'increment our row counter
UNTIL x = numRows +1' or x = List.numRecords + 1'check all rows so do it again while mouse is down
LONG IF drawList = _TRUE
fn DrawList(List)
END IF
err = FN EventAvail(0,evnt)'allows time for system tasks and stop the spinning cursor in OSX
WEND
WhichString = List.newselect' + BUTTON(List.LScrollBtn) - 1'when the mouse is up this is our string
Selected$ =STR#(List.STResNo,WhichString)
END FN = Selected$'return it to whoever called



'~Initialize indivual lists

/*
This is the place we set up the list.  You should define one global list record for each
list you want to display.  Note that you can increase or decrease the number of columns you
need to display and then set the width, font , size, style of the list and the individual
color of each column.  This example uses STR# resources for the data but it could just as easily
be an array of any kind.   I chose the  -  character for the delimiter between columns and the ^ to
denote what follows is an icon family resource.  You need to add these resources to your resource
file.  Note the [] brackets necessary for arrays in records.  I use a User Item in PG for this demo
to set the basic area for the list and then modify the height depending on the font chosen.  I also
modify the last row to set it to the full right side of the list as it is drawn.  If you calculated
the exact width needed for columns or did not use a PG object you could eliminate that step.

This shows how you could add all kinds of things to a list display.  More graphics, back colors for
each cell etc.

*/

clear LOCAL
DIM as int WhichList,numRows,ht,CurRes
DIM @r,g,b
DIM @loop
DIM as handle resHndl&
dim @fontNum
DIM fontName as str255
'~'2
LOCAL FN InitHelpTopicList
'~'2
FN pGgetObj(_MyCalendarHelp2Wnd,_HelpTopicList)'get our user item for the list
HelpList.WhichString = 1
HelpList.newselect   = 1
HelpList.LScrollBtn  = _scrlBar1WClass39
HelpList.ncols       = 1'the number of columns
HelpList.STResNo     = _HelpListSTR'the resource number of the STR#
HelpList.ListRect    = @gObjT'basic size of the list rectangle
HelpList.colwd%[1]   = 200'width of each column
HelpList.txtalign[1] = 0'alignment of individual columns
'GetFNum("Arial",fontNum)
HelpList.fnt         = 3'the font for this list
HelpList.sze         = 12'the size for this list
HelpList.styl        = 0
HelpList.delim$      = "-"'delimiter between cell data
text HelpList.fnt ,HelpList.sze,HelpList.styl
resHndl& = FN GETRESOURCE(_"STR#",_HelpListSTR)'Get a handle to the STR# resource we are using
LONG IF resHndl&
HelpList.numRecords = {[resHndl&]}'count the number of elements
XELSE
HelpList.numRecords = 0'problem - no handle - no elements
END IF
'~'2
'just adjust the overall rectangle if the one drawn in PG is not exactly a multiple of n rows
'~'2
numRows = (HelpList.ListRect.bottom-HelpList.ListRect.top)\(USR FONTHEIGHT)
ht = USR FONTHEIGHT * numRows
HelpList.ListRect.bottom = HelpList.ListRect.top + ht +2
END FN


CLEAR LOCAL
DIM CurRes
'~'2
LOCAL FN ClickNoteScrollBtn'We clicked in the list
'~'2
WINDOW gWhichClass
SELECT gWhichClass
case _MyCalendarHelp2Wnd
LONG IF gWhichButton = _scrlBar1WClass39
fn DrawList(HelpList)
END IF
end select
END FN


clear local
DIM as int  numRows
'~'2
Local Fn ViewAListItem(List AS ^ListRecord,selected,item)'view selected line or any line passed in item
'~'2
LONG IF selected <> _false'view the currently selected line
scroll BUTTON List.LScrollBtn,List.newselect' + numRows
xelse
LONG IF item <> 0'or view a line passed in the var item
List.newselect = item'and selected is set to _false
SCROLL BUTTON List.LScrollBtn,item
END IF
END IF
fn DrawList(List)
END FN



'~':

"EndOfList"

DIM TheResponse,Temp$,TxResNo,teHndl&,CurRes,resref
dim as handle resHndl&
Dim sloc,Da$,Note$,resID%
dim t as rect
dim dashloc,slashloc,Dur,slashloc2


SELECT gLongAction&
'~'2
CASE _mStart
FN InitHelpTopicList
'~'2
CASE _oUserUpdate
LONG IF gObjUserTp& = _"List"
SELECT gWhichWindow
CASE _MyCalendarHelp2Wnd
FN DrawList(HelpList)
END SELECT
END IF

'~'2

'~'2
CASE _btnLong
FN ClickNoteScrollBtn

end select

'~'4
IF 0 then return